home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr52 / pow_tb.zip / TBSTACK1.PRG < prev    next >
Text File  |  1993-05-14  |  4KB  |  165 lines
  1.    /* tbStack1.prg: Browses supplier.dbf, stacking all supplier address
  2.    details in column2 of the browse display.
  3.    
  4.    Copyright (C) Dave Boettcher 1993. This source code, and functional 
  5.    fragments thereof, may only be distributed unchanged and as part of 
  6.    the file POWER_TB.ARJ. See POWER_TB.TXT for full copyright details.
  7.    
  8.    Last change:  14 May 93       6:50 pm
  9.    */
  10.    
  11.    #include "setcurs.ch"
  12.    #include "inkey.ch"
  13.    #include "box.ch"
  14.    
  15.    static nLines := 6
  16.    static nLineNumber := 1
  17.    static nLineLength := 20
  18.    
  19. function main()
  20.    
  21.    local oBrowse
  22.    local oColumn
  23.    local nKey
  24.    local lCont := .T.
  25.    local oldColour := setcolor("w+/b")
  26.    local oldCursor := setcursor(SC_NONE)   
  27.    
  28.    use supplier new
  29.    
  30.    clear screen
  31.    @ 0, 0, 24, 79 box B_DOUBLE
  32.    
  33.    oBrowse := tbrowsedb(1, 1, 23, 78)
  34.    oBrowse:headsep   := "─┬─"
  35.    oBrowse:colsep    := " │ "
  36.    oBrowse:goBottomBlock := { || dbGoBottom(), nLineNumber := nLines }
  37.    oBrowse:goTopBlock := { || dbGoTop(), nLineNumber := 1 }
  38.    oBrowse:skipBlock := { |n| multiskip(n) }
  39.    
  40.    oColumn := TBColumnNew("Name", {|| col1Conts() })
  41.    oColumn:width := 30
  42.    oColumn:footsep := "─┴─"
  43.    oBrowse:AddColumn(oColumn)
  44.    
  45.    oColumn := TBColumnNew("Details", {|| col2Conts() })
  46.    oColumn:width := nLineLength 
  47.    oColumn:footsep := "─┴─"
  48.    oBrowse:AddColumn(oColumn)
  49.    
  50.    do while lCont
  51.       
  52.       do while .not. oBrowse:stable .AND. (nKey := InKey()) == 0
  53.          oBrowse:Stabilize()
  54.       enddo
  55.       
  56.       if oBrowse:stable
  57.          if (oBrowse:hitTop .OR. oBrowse:hitBottom)
  58.             Tone(125,0)
  59.          endif
  60.          nKey := InKey(0)
  61.       endif
  62.       
  63.       Do Case
  64.          Case nKey == K_DOWN        ;  oBrowse:Down()
  65.          Case nKey == K_UP          ;  oBrowse:Up()
  66.          Case nKey == K_LEFT        ;  oBrowse:Left()
  67.          Case nKey == K_RIGHT       ;  oBrowse:Right()
  68.          Case nKey == K_PGDN        ;  oBrowse:PageDown()
  69.          Case nKey == K_PGUP        ;  oBrowse:PageUp()
  70.          Case nKey == K_CTRL_PGUP   ;  oBrowse:GoTop()
  71.          Case nKey == K_CTRL_PGDN   ;  oBrowse:GoBottom()
  72.          Case nKey == K_ESC         ;  lCont := .F.
  73.       endcase
  74.       
  75.    enddo
  76.    
  77.    setcolor(oldColour)
  78.    setcursor(oldCursor)
  79.    clear screen
  80.    
  81.    return nil
  82.    
  83. function col1Conts()
  84.    
  85.    local cStr
  86.    
  87.    if nLineNumber == 1
  88.       cStr := supplier->name
  89.    else
  90.       cStr := " "
  91.    endif
  92.    
  93.    return cStr
  94.    
  95. function col2Conts()
  96.    
  97.    local cStr
  98.    
  99.    do case
  100.       case nLineNumber == 1
  101.          cStr := supplier->street
  102.       case nLineNumber == 2
  103.          cStr := supplier->village
  104.       case nLineNumber == 3
  105.          cStr := supplier->town
  106.       case nLineNumber == 4
  107.          cStr := supplier->county
  108.       case nLineNumber == 5
  109.          cStr := supplier->postcode
  110.       case nLineNumber == 6
  111.          cStr := replicate("-", nLineLength) 
  112.    endcase
  113.    
  114.    return cStr
  115.    
  116.    
  117. function MultiSkip( nRequested )
  118.    
  119.    local nAllowed := 0
  120.    
  121.    do case
  122.          
  123.       case nRequested == 0
  124.          
  125.          skip 0
  126.          
  127.       case nRequested > 0
  128.          
  129.          do while (!eof()) .and. nAllowed < nRequested
  130.             nLineNumber++
  131.             nAllowed++
  132.             
  133.             if nLineNumber > nLines
  134.                skip 1
  135.                nLineNumber := 1
  136.             endif
  137.             
  138.          enddo
  139.          
  140.          if eof()
  141.             nAllowed--
  142.             skip -1
  143.             nLineNumber := nLines
  144.          endif
  145.          
  146.       case nRequested < 0
  147.          
  148.          do while (!bof()) .and. nAllowed > nRequested
  149.             nLineNumber--
  150.             nAllowed--
  151.             if nLineNumber == 0
  152.                skip -1
  153.                nLineNumber := nLines
  154.             endif
  155.          enddo
  156.          
  157.          if bof()
  158.             nAllowed++
  159.             nLineNumber := 1
  160.          endif
  161.          
  162.    endcase
  163.    
  164.    return (nAllowed)
  165.